home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / win_m_p / pwez51.zip / MULTSAM3.BAS < prev    next >
BASIC Source File  |  1992-04-01  |  5KB  |  127 lines
  1. DECLARE SUB SETINPT (SCRN%, WID%, EX$, INPT%(), INPT$(), BC%)
  2. DECLARE SUB SETWIND (FST%, S%, SH%)
  3. DECLARE SUB MULTINPT (SCRN%, TOFLD%, EXIT$, AEXIT%, RKEY%, RTRN$())
  4. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  5. DECLARE SUB PRINTW (TEXT$, R%, LC%)
  6. DECLARE SUB INPTINIT (DFORMAT%, ISDOT%, EXIT$)
  7. '***************************************************************************
  8. ' This is an example of using auto-exit fields in MULTINPT to print an  ****
  9. ' instruction line.                                                     ****
  10. '***************************************************************************
  11. '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:    ****
  12. '***************************************************************************
  13. '**** For QB4.+ unenhanced version use QB4UNEN.QLB                      ****
  14. '**** For BASIC 7.+ unenhanced version use PDSUNEN.QLB                  ****
  15. '**** For QB4.50 enhanced version use QBALL45.QLB or QBNER45.QLB        ****
  16. '**** For QB4.00/4.00b enhanced version use QBALL40.QLB or QBNER40.QLB  ****
  17. '**** For BASIC 7.0 enhanced version use PDSALL70.QLB or PDSNER70.QLB   ****
  18. '**** For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB   ****
  19. '**** Load QB or QBX with the /L option using the correct library       ****
  20. '***************************************************************************
  21.  
  22. CALL SETWIND(1, 1, 7)                   ' INITIALIZE WINDOW MEMORY
  23. CALL INPTINIT(1, 1, "")                 ' INITIALIZE INPUT MEMORY
  24. COLOR 7, 0: CLS                         ' BLANK THE SCREEN
  25. DIM RTRN$(4)                            ' FOR THE FOUR FIELDS
  26. DIM I AS STRING * 76                    ' FOR THE INSTRUCTION LINE
  27. '---------------------------------------------------------------------------
  28. ' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
  29.  
  30. REDIM INPT%(25), INPT$(4)
  31. TOFLD% = 1: B% = 1
  32. DO
  33.   READ INPT%(B%)
  34.   IF INPT%(B%) = 9999 THEN EXIT DO
  35.   B% = B% + 1
  36.   FOR X% = 1 TO 5
  37.      READ INPT%(B%)
  38.      B% = B% + 1
  39.   NEXT
  40.   READ INPT$(TOFLD%)
  41.   TOFLD% = TOFLD% + 1
  42. LOOP
  43.  
  44. ' Auto-exit ( always ) - auto advance - numeric with no decimal places
  45. DATA 11000,5,5,4,15,99,""
  46. ' Auto-exit ( always ) - auto advance - numeric with no decimal places
  47. DATA 11000,7,5,4,15,99,""
  48. ' Protected - numeric with no decimal places
  49. DATA 100,9,5,5,15,99,""
  50. ' Auto-exit ( always ) - Alpha / numeric
  51. DATA 10007,11,5,15,15,99,""
  52. DATA 9999
  53.  
  54. CALL SETINPT(1, 80, "E", INPT%(), INPT$(), 0)       ' SET UP MULTI-INPUT AND
  55. ERASE INPT%, INPT$                                   ' GET THE MEMORY BACK.
  56.  
  57. '----------------------------------------------------------------------------
  58. ' THE MAIN PROGRAM
  59.  
  60. ' program
  61. ' program
  62.  
  63. GOSUB AUTOEXITEXAMPLE
  64.  
  65. ' program
  66. ' program
  67.  
  68. END
  69.  
  70. '---------------------------------------------------------------------------
  71. ' MULTI-FIELD SUB-ROUTINE
  72.  
  73. AUTOEXITEXAMPLE:
  74.  
  75. TOFLD% = 1: AUTOEXIT% = 0:                ' START IN FIELD 1.  PRINT ALL
  76.                                          ' FIELDS.
  77. '----------------------------------------------------------------------------
  78. ' MAKE A WINDOW.  PRINT INSTRUCTIONS
  79.  
  80. CALL MAKEWIND(1, "@Auto-exit fields used print an instruction line", 1, 1, 80, 16, 112, 102)
  81. CALL PRINTW("Auto-exit and auto advance with numeric input", 2, 15)
  82. CALL PRINTW("+", 3, 5)
  83. CALL PRINTW("Auto-exit and auto advance with numeric input", 4, 15)
  84. CALL PRINTW("Protected Field", 6, 15)
  85. CALL PRINTW("Alpha-numeric", 8, 24)
  86. CALL PRINTW("Press ESC to end demonstration", 10, 100)
  87. CALL NEWCOLOR(15)
  88. '----------------------------------------------------------------------------
  89. PREINPT:
  90.    SELECT CASE TOFLD%                    ' CURSOR MOVING TO WHICH FIELD?
  91.      CASE 1                              ' FIELD 1
  92.         I = "Input the first number."    ' INSTRUCTIONS
  93.      CASE 2                              ' FIELD 2
  94.         I = "Input the second number."   '   "
  95.      CASE 4                              ' FIELD 4
  96.         I = "Input anything!"            '   "
  97.     END SELECT
  98.  
  99. I = "INSTRUCTION FOR FIELD" + STR$(TOFLD%) + ": " + I
  100. CALL PRINTW(I, 12, 2)                    ' PRINT INSTRUCTIONS
  101.  
  102. CALL MULTINPT(1, TOFLD%, "", AUTOEXIT%, RKEY%, RTRN$())
  103.  
  104. ' FIRST CHECK TO SEE IF THE EXIT WAS DUE TO FIELD 1 OR 2 BEING EXITED,
  105. ' EITHER BY THE AUTO-EXIT FEATURE OR BY THE "ESC" KEY.
  106. ' ON EXIT AUTOEXIT% POINTS TO THE FIELD THE CURSOR WAS ON WHEN MULTINPT
  107. ' WAS EXITED ( IF IT WAS AN AUTOEXIT FIELD. ).  ON EXIT TOFLD% POINTS TO
  108. ' THE FIELD THE CURSOR IS MOVING INTO.
  109. ' THE CALL TO MULTINPT IN THE "IF - END IF" BLOCK IS USED TO UPDATE
  110. ' FIELD 3 ONLY.
  111.  
  112.  
  113. IF AUTOEXIT% = 1 OR AUTOEXIT% = 2 THEN               ' FIELD 1 OR 2. UPDATE
  114.   RTRN$(3) = STR$(VAL(RTRN$(1)) + VAL(RTRN$(2)))     ' THE PROTECTED FIELD 3.
  115.   IF RTRN$(1) + RTRN$(2) = "" THEN RTRN$(3) = ""
  116.   CALL MULTINPT(1, 1, "VIEW", 3, JUNK%, RTRN$())     ' UPDATE FIELD 3 ONLY.
  117. END IF
  118.  
  119. IF RKEY% <> 27 GOTO PREINPT                   ' WAS NOT ESC.
  120.                                               ' UPON EXIT OF MULTINPT TOFLD%
  121.                                               ' IS SET TO NEXT FIELD NUMBER
  122.                                               ' FOR THE CURSOR.
  123.  
  124. RETURN                             ' PROGRAM WILL ALWAYS COMES HERE IF ESC
  125.                                    ' IS PRESSED AS RKEY% = 27
  126.  
  127.